home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / filesetsMenu.tcl < prev    next >
Encoding:
Text File  |  1999-04-13  |  48.4 KB  |  1,657 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "filesetsMenu.tcl"
  6.  #                    created: 20/7/96 {6:22:25 pm} 
  7.  #                   last update: 13/4/1999 {8:24:03 pm} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #==============================================================================
  15.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  16.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  17.  # on occasion, but this isn't critical.
  18.  #==============================================================================
  19.  # 
  20.  #  modified by  rev reason
  21.  #  -------- --- --- -----------
  22.  #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
  23.  #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
  24.  #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
  25.  #  10/3/97  VMD 1.3 added 'procedural' fsets, including 'Open Windows'
  26.  #  6/4/97   VMD 1.31 various fixes incorporated - thanks!
  27.  #  11/7/97  VMD 1.4 added cache for the fileset menu, improved wc proc.
  28.  #  15/7/97  VMD 1.41 better handling of out-of-date filesets, and dir opening
  29.  #  15/7/97  VMD 1.42 placed cache in separate file.
  30.  #  21/7/97  VMD 1.43 added glob patterns to ignore for directory filesets
  31.  #  22/7/97  VMD 1.5 more sophisticated menu caching.  No more long rebuilds!
  32.  #  10/9/97  VMD 1.6 simplified some stuff for new Alpha-Tcl
  33.  #  7/12/97  VMD 1.6.1 makes use of winNumDirty flag
  34.  #  12/1/98  VMD 1.6.2 removes special treatment of *recent*
  35.  #  15/1/1999  VMD 1.7.2 a year of improvements....
  36.  # ###################################################################
  37.  ##
  38.  
  39. ## 
  40.  # These procedures are now more robust and general-purpose.  Basic new
  41.  # features are:
  42.  # 
  43.  #  * user configurable menu * unique-menu names are ensured, so there can
  44.  #  be no clashes * new fileset types ('tex' and 'fromHierarchy') * new
  45.  #  utility functions ('stuff', 'wordCount',...)  * filesets need not
  46.  #  appear in the menu; in fact they can be anywhere you like
  47.  #          
  48.  # Known Bugs:
  49.  # 
  50.  #  You cannot have a hierarchial fileset which contains more than one
  51.  #  folder with the same name as the fileset, including the base folder. 
  52.  #  This is very hard to fix, and the easy workaround is just to rename the
  53.  #  fileset in some minor way.
  54.  ##
  55.  
  56. alpha::menu filesetMenu 1.7.5 global "•131" {
  57. } {filesetMenu} {} uninstall {this-file} help {[editMark [file join $HOME Help "Alpha Manual"] "File Sets" -r]}
  58.  
  59. proc filesetMenu {} {}
  60.  
  61. # Build some filesets on the fly.
  62. set gfileSets(Help) [file join $HOME Help *]
  63. set gfileSets(System) [list [file join $HOME Tcl SystemCode *.tcl] 2]
  64. set gfileSets(Menus) [list [file join $HOME Tcl Menus *.tcl] 2]
  65. set gfileSets(Modes) [list [file join $HOME Tcl Modes *.tcl] 2]
  66.  
  67. # Declare their types
  68. set gfileSetsType(Help) "fromDirectory"
  69. set gfileSetsType(System) "fromHierarchy"
  70. set gfileSetsType(Modes) "fromHierarchy"
  71. set gfileSetsType(Menus) "fromHierarchy"
  72.  
  73. proc filesetRegisterProcedural {name proc} {
  74.     global gfileSets gfileSetsType
  75.     set gfileSets($name) $proc
  76.     set gfileSetsType($name) "procedural"
  77. }
  78.  
  79. filesetRegisterProcedural "Open Windows" procFilesetOpenWindows
  80. filesetRegisterProcedural "Top Window's Folder" procFilesetDirTopWin
  81. filesetRegisterProcedural "Recurse in folder…" procFilesetRecurseIn
  82.  
  83. # Procs for procedural filesets
  84. proc procFilesetRecurseIn {} {
  85.     return [file::recurse [get_directory -p "Search recursively in which folder?"]]
  86. }
  87.  
  88. proc procFilesetOpenWindows {} { return [winNames -f] }
  89. proc procFilesetDirTopWin {} { 
  90.     if {[set w [win::Current]] == ""} {
  91.     return ""
  92.     } else {
  93.     return [glob -t TEXT -nocomplain [file join [file dirname [win::Current]] *]]
  94.     }
  95. }
  96.  
  97. if {![file exists [file join $HOME Tcl Packages]]} { file mkdir [file join $HOME Tcl Packages] }
  98. set gfileSets(Packages) [list [file join $HOME Tcl Packages *.tcl] 2]
  99. set gfileSetsType(Packages) "fromHierarchy"
  100.  
  101. lunion varPrefs(Files) currFileSet
  102. # Default curr fileset is the first one. 
  103. newPref var currFileSet "System" global changeFileSet gfileSets array
  104.  
  105. # ◊◊◊◊ Variables and flags ◊◊◊◊ #
  106.  
  107. #################################################
  108. # Any of these can be over-ridden by the stored #
  109. # definitions in defs.tcl, arrdefs.tcl          #
  110. #################################################
  111.  
  112. ## 
  113.  # We don't show the 'help' fileset, since it's under the MacOS AppleGuide
  114.  # menu.  Also we could perhaps yank tex-filesets away into their own menu,
  115.  # in which case the tex-system could add to this variable as it went
  116.  # along.
  117.  ##
  118. lunion filesetsNotInMenu "Help" "Open Windows" "Top Window's Folder" \
  119.   "Recurse in folder…"
  120.  
  121. ## 
  122.  # A type is a means of    generating a fileset given its 
  123.  # description in the variable 'gfileSets(name)':
  124.  ##
  125. lunion fileSetsTypes "list" "glob" "fromHierarchy" "procedural"
  126.  
  127. ## 
  128.  # A menu type is a means of prompting the user and characterising the
  129.  # interface to a type, even though the actual storage may be very simple
  130.  # (a list in most cases).
  131.  ##
  132. set fileSetsTypesThing(fromDirectory) "glob"
  133. set fileSetsTypesThing(fromHierarchy) "fromHierarchy"
  134. set fileSetsTypesThing(think) "list"
  135. set fileSetsTypesThing(codewarrior) "list"
  136. set fileSetsTypesThing(ftp) "list"
  137. set fileSetsTypesThing(fromOpenWindows) "list"
  138. set fileSetsTypesThing(procedural) "procedural"
  139.  
  140. ## 
  141.  # To add a new fileset type, you need to define the following:
  142.  #       set fileSetsTypesThing(myType) "list"
  143.  #       proc    myTypeCreateFileset    {} {}
  144.  #       proc    myTypeFilesetUpdate    {name} {}
  145.  # 
  146.  # For more complex types (e.g. the tex-type), define as follows:
  147.  #       set fileSetsTypesThing(myType) "myType"
  148.  #       proc    myTypeCreateFileset    {} {}
  149.  #       proc    myTypeFilesetSelected {    fset menu item }    {}
  150.  #       proc    myTypeFilesetUpdate    { name } {}
  151.  #       proc    myTypeListFilesInFileset { name    } {}
  152.  #       proc    myTypeMakeFileSetSubMenu { name    } {}
  153.  # 
  154.  # These procedures will all be called automatically under the correct
  155.  # circumstances.  The purposes of these are as follows:
  156.  #
  157.  #   'create'   -- query the user for name etc. and create
  158.  #   'update'   -- given the information in 'gfileSets', recalculate
  159.  #                   the member files.
  160.  #   'selected' -- a member was selected in a menu.
  161.  #   'list'     -- given info in all except 'fileSets', return list
  162.  #                 of files to be stored in that variable.
  163.  #   'submenu'  -- generate the sub-menu
  164.  # 
  165.  # Your code may wish to call 'isWindowInFileset ?win?  ?type?'  to check
  166.  # if a given (current by default) window is in a fileset of a given type.
  167.  ##
  168.  
  169. ## 
  170.  # -------------------------------------------------------------------------
  171.  #     
  172.  #    "filesetSortOrder" --
  173.  #    
  174.  #   The structure of this variable dictates how the fileset menu is
  175.  #   structured:
  176.  #           
  177.  #           '{pattern p}' 
  178.  #               lists all filesets which    match 'p'
  179.  #           '-' 
  180.  #               adds    a separator    line
  181.  #           '{list of types}' 
  182.  #               lists all filesets of those types.
  183.  #           '{submenu name sub-order-list}' 
  184.  #               adds    a submenu with name    'name' and recursively
  185.  #               adds    filesets to    that submenu as    given by the 
  186.  #               sub-order.
  187.  #               
  188.  #       Leading,    trailing and double    separators are automatically
  189.  #       removed.
  190.  #     
  191.  # -------------------------------------------------------------------------
  192.  ##
  193. ensureset filesetSortOrder { {pattern *System} {pattern Packages} \
  194.     {pattern Menus} {pattern Modes} {pattern Preferences} \
  195.     - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} \
  196.     - {fromDirectory think codewarrior ftp \
  197.     fromOpenWindows fromHierarchy} * } 
  198.  
  199. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  200. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  201. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  202. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  203. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  204. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  205. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  206. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  207. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  208.  
  209.  
  210. ## 
  211.  # The meaning of these    flags is as    follows:
  212.  #       sortFilesetItems    -- 
  213.  #           a type can have the option of being unsorted    (e.g. tex-filesets)
  214.  #       indentFilesetItems --
  215.  #           visual formatting may be    of relevance to    some types
  216.  #       sortFilesetsByType -- 
  217.  #           use the variable    'filesetSortOrder' to determine    the
  218.  #           visual structure    of the fileset menu
  219.  #       autoAdjustFileset --
  220.  #           when    a file is selected from    the    menu, do we    try    and    
  221.  #           keep    'currFileSet' accurate?
  222.  #       includeNonTextFiles --
  223.  #           filesets may include non-text files.  Alpha will tell the
  224.  #           finder to open these if they are selected.
  225.  ##        
  226. newPref flag sortFilesetItems 0 "fileset"
  227. newPref flag indentFilesetItems 0 "fileset"
  228. newPref flag sortFilesetsByType 0 "fileset" rebuildSomeFilesetMenu
  229. newPref flag autoAdjustFileset 1 "fileset"
  230. newPref flag includeNonTextFiles 0 "fileset" rebuildSomeFilesetMenu
  231.  
  232. # To add a new fileset type, all we have to do is this:
  233. # set fileSetsTypesThing(tex) "tex"
  234. # lappend fileSetsTypes "tex"
  235. # If you create new types just add lines like that
  236.  
  237. #===========================================================================
  238. # The support routines.
  239. #===========================================================================
  240. # Called from Alpha to get list of files for current file set.
  241. proc getCurrFileSet {} {
  242.     global currFileSet
  243.     return [getFileSet $currFileSet]
  244. }
  245.  
  246. # Called from Alpha to get names.  The first name returned is taken to
  247. # be the current fileset.  For Alpha < 8.0, the list returned contains
  248. # the first item twice (as the first item, and then in its correct 
  249. # position in the list).  For Alpha >= 8.0 this silly behaviour has 
  250. # been removed.
  251. proc getFileSetNames {{ordered 0}} {
  252.     global gfileSets currFileSet gDirScan
  253.     set perm {}
  254.     if {!$ordered && $currFileSet != ""} {
  255.     lappend perm $currFileSet
  256.     }
  257.     foreach n [lsort -ignore [array names gfileSets]] {
  258.     if {!$ordered && ([info tclversion] >= 8.0) && $n == $currFileSet} {continue}
  259.     if {[info exists gDirScan($n)]} {
  260.         lappend temp $n
  261.     } else {
  262.         lappend perm $n
  263.     }
  264.     }
  265.     if {[info exists temp]} {
  266.     return [concat $perm - $temp]
  267.     } else {
  268.     return $perm
  269.     }
  270. }
  271.  
  272. #================================================================================
  273. # Edit a file from a fileset via list dialogs (no mousing around).
  274. #================================================================================
  275. proc editFile {} {
  276.     global currFileSet modifiedVars gfileSetsType file::separator
  277.     
  278.     if {[catch {pickFileset "" {Fileset?} "list"} fset]} {return}
  279.     set currFileSet $fset
  280.     lappend modifiedVars currFileSet
  281.     
  282.     set ff [getFilesInSet $fset]
  283.     foreach f $ff {
  284.     lappend disp [file tail $f]
  285.     }
  286.     if {[catch {listpick -l -p {File?} [lsort -ignore $disp]} files]} {return}
  287.     foreach res $files {
  288.     set ind [lsearch $ff "\*${file::separator}$res"]
  289.     if {$gfileSetsType($fset) == "ftp"} {
  290.         ftpFilesetOpen $fset [lindex $ff $ind]
  291.     } else {
  292.         catch {generalOpenFileitem [lindex $ff $ind]}
  293.     }
  294.     }
  295. }
  296.  
  297. # We only return TEXT files, since we don't want Alpha
  298. # manipulating the data fork of non-text files.
  299. proc getFileSet {fset} {
  300.     global filesetmodeVars
  301.     if {$filesetmodeVars(includeNonTextFiles)} {
  302.     set fnames ""
  303.     foreach f [getFilesInSet $fset] {
  304.         if {[file isfile $f]} {
  305.         getFileInfo $f a
  306.         if {$a(type) == "TEXT"} {
  307.             lappend fnames $f
  308.         }
  309.         }
  310.     }
  311.     return $fnames
  312.     } else {
  313.     return [getFilesInSet $fset]
  314.     }
  315. }
  316.  
  317. proc browseFileset {{fset ""}} {
  318.     global tileLeft tileTop tileWidth errorHeight
  319.     
  320.     if {[catch {pickFileset $fset {Fileset?}} fset]} {return}
  321.     
  322.     foreach f [getFilesInSet $fset] {
  323.     append text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  324.     }
  325.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight \
  326.       -m Brws -info "(<cr> to go to file)\r-----\r$text\r"
  327.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  328.     message ""
  329. }    
  330.  
  331. # ◊◊◊◊ Basic procedures ◊◊◊◊ #
  332.  
  333. namespace eval fileset {}
  334.  
  335. # under development
  336. proc newFileset {} {
  337.     global currFileSet gfileSetsType fileSetsTypesThing modifiedArrayElements
  338.     foreach type  {
  339.     lappend dialog -n $type 
  340.     }
  341.     set res [dialog::paged -pageproc fileset::page [lsort -ignore [array names fileSetsTypesThing]]]
  342.  
  343.     if {![string length $name]} return
  344.     
  345.     lappend modifiedArrayElements [list $name gfileSetsType]
  346.     set gfileSetsType($name) $type
  347.     
  348.     set currFileSet $name
  349.     filesetsJustChanged $type $name
  350.     return $currFileSet
  351. }
  352.  
  353. proc fileset::page {fset x y} {
  354.     return [fileset::create$fset $x $y]
  355. }
  356.  
  357. proc newFileset {{type ""}} {
  358.     global currFileSet gfileSetsType fileSetsTypesThing modifiedArrayElements
  359.     if {$type == ""} {
  360.     set type [dialog::optionMenu "New fileset type?"  [lsort -ignore [array names fileSetsTypesThing]] "fromDirectory"]
  361.     }
  362.     set name [eval ${type}CreateFileset]
  363.  
  364.     if {![string length $name]} return
  365.     
  366.     lappend modifiedArrayElements [list $name gfileSetsType]
  367.     set gfileSetsType($name) $type
  368.     
  369.     set currFileSet $name
  370.     filesetsJustChanged $type $name
  371.     return $currFileSet
  372. }
  373.  
  374.  
  375. ## 
  376.  # -------------------------------------------------------------------------
  377.  # 
  378.  # "filesetsJustChanged" --
  379.  # 
  380.  #  If we've added, deleted, modified a fileset, we call this procedure.
  381.  #  In most cases we must rebuild everything (due to limitations in Alpha),
  382.  #  but for 'procedural' filesets, we can just do the utilities menu.
  383.  # -------------------------------------------------------------------------
  384.  ##
  385. proc filesetsJustChanged {type name} {
  386.     if {$type == "procedural"} {
  387.     global filesetsNotInMenu modifiedVars
  388.     if {[lsearch $filesetsNotInMenu $name] == -1} {
  389.         lappend filesetsNotInMenu $name
  390.         lappend modifiedVars filesetsNotInMenu
  391.     }
  392.     rebuildFilesetUtilsMenu
  393.     } else {
  394.     rebuildAllFilesets 1
  395.     }
  396. }
  397.  
  398. proc printFileset { {fset ""}} {
  399.     if {[catch {pickFileset $fset "Print which Fileset?"} fset]} {return}
  400.     foreach f [getFilesInSet $fset] {
  401.     print $f
  402.     }
  403. }
  404.  
  405.  
  406. proc deleteFileset { {fset ""} {yes 0} } {
  407.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  408.     global filesetMenu subMenuFilesetInfo subMenuInfo filesetsNotInMenu
  409.     global modifiedVars modifiedArrayElements
  410.     
  411.     if {[catch {pickFileset $fset "Delete which Fileset?"} fset]} {return}
  412.     if {$currFileSet == $fset} {catch {set currFileSet System}}
  413.     
  414.     if {$yes || [dialog::yesno "Delete fileset \"$fset\"?"]} {
  415.     catch {unset "fileSetsExtra($fset)"}
  416.     catch {unset "gfileSetsType($fset)"}
  417.     catch {unset "fileSets($fset)"}
  418.     catch {unset "gfileSets($fset)"}
  419.     
  420.     lappend modifiedArrayElements \
  421.       [list $fset gfileSetsType] [list $fset fileSetsExtra] \
  422.       [list $fset gfileSets]
  423.     
  424.     set err [catch {removeFilesetFromMenu $fset}]
  425.     
  426.     if {[set l [lsearch -exact $filesetsNotInMenu $fset]] != -1} {
  427.         set filesetsNotInMenu [lreplace $filesetsNotInMenu $l $l]
  428.         lappend modifiedVars filesetsNotInMenu
  429.         deleteMenuItem -m choose $fset
  430.         deleteMenuItem -m hideFileset $fset
  431.         return
  432.     }
  433.     if {$err} {
  434.         # it's on a submenu or somewhere else so we just have
  435.         # to do the lot!
  436.         if {!$yes} { rebuildAllFilesets 1 }
  437.     } else {
  438.         deleteMenuItem -m choose $fset
  439.         deleteMenuItem -m hideFileset $fset
  440.     }
  441.     }
  442. }
  443.  
  444. proc removeFilesetFromMenu {fset} {
  445.     global subMenuFilesetInfo subMenuInfo
  446.     # find its menu:
  447.     if {[info exists subMenuFilesetInfo($fset)]} {
  448.     foreach m $subMenuFilesetInfo($fset) {
  449.         # remove info about it's name
  450.         if {[info exists subMenuInfo($m)]} {
  451.         unset subMenuInfo($m)
  452.         cache::add filesetMenuCache "eval" [list unset subMenuInfo($m)]
  453.         }
  454.     }
  455.     set base [lindex $subMenuFilesetInfo($fset) 0]
  456.     unset subMenuFilesetInfo($fset)
  457.     cache::add filesetMenuCache "eval" [list unset subMenuFilesetInfo($fset)]
  458.     cache::snippetRemove $fset
  459.     # this will fail if it's on a submenu or if it isn't a menu at all
  460.     deleteMenuItem -m $filesetMenu $base
  461.     cache::add filesetMenuCache "eval" [list deleteMenuItem -m $filesetMenu $base]
  462.     } else {
  463.     # I think I do nothing
  464.     }
  465.     
  466. }
  467.  
  468. ## 
  469.  # -------------------------------------------------------------------------
  470.  #     
  471.  #    "pickFileset" --
  472.  #    
  473.  # Ask the user for a/several filesets.  If 'fset' is set, we just return
  474.  # that (this avoids 'if {$fset != ""} { set fset [pick...]  } constructs
  475.  # everywhere).  A prompt can be given, and a dialog type (either a
  476.  # listpick, a pop-up menu, or a listpick with multiple selection), and
  477.  # extra items can be added to the list if desired. 
  478.  # -------------------------------------------------------------------------
  479.  ##
  480. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  481.     global gfileSets currFileSet
  482.     if { $fset != "" } { return $fset }
  483.     switch -- $type {
  484.     "popup" {
  485.         set fset [eval [list prompt $prompt \
  486.           $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  487.         if {![info exists gfileSets($fset)]} { error "No such fileset" }
  488.         return $fset
  489.     }
  490.     "list" {
  491.         return [listpick -p $prompt -L $currFileSet \
  492.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  493.     }
  494.     "multilist" {
  495.         return [listpick -p $prompt -l -L $currFileSet \
  496.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  497.     }        
  498.     }
  499. }
  500.  
  501. proc renameFileset {} {
  502.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  503.     global fileSetsTypesThing modifiedArrayElements
  504.     
  505.     if {[catch {pickFileset "" {Fileset to rename?}} fset]} {return}
  506.     
  507.     set name [getline "Rename to:" $fset]
  508.     if {![string length $name] || $name == $fset} return
  509.     
  510.     set gfileSets($name) $gfileSets($fset)
  511.     set gfileSetsType($name) $gfileSetsType($fset)
  512.     catch {set fileSets($name) $fileSets($fset)}
  513.     catch {set fileSetsExtra($name) $fileSetsExtra($fset)}
  514.     
  515.     deleteFileset $fset 1
  516.     
  517.     lappend modifiedArrayElements [list $name gfileSets]
  518.     lappend modifiedArrayElements [list $name gfileSetsType]
  519.     lappend modifiedArrayElements [list $name fileSetsExtra]
  520.     
  521.     filesetsJustChanged $gfileSetsType($name) $name
  522.     set currFileSet $name
  523. }
  524.  
  525. proc updateCurrentFileset {} {
  526.     global currFileSet
  527.     updateAFileset $currFileSet
  528. }
  529.  
  530. proc updateAFileset { {fset ""} } {
  531.     if {[catch {pickFileset $fset} fset]} {return}
  532.     
  533.     global gfileSetsType fileSets subMenuFilesetInfo subMenuInfo
  534.     
  535.     set type $gfileSetsType($fset)
  536.     catch {eval [list "${type}FilesetUpdate" $fset] }
  537.     set m [makeFileSetAndMenu $fset 1]
  538.     # we could rebuild the menu with this: but we don't
  539.     cache::add filesetMenuCache "eval" $m
  540.     if {[info exists subMenuFilesetInfo($fset)]} {
  541.     # if the fileset already has a base menu, use that:
  542.     foreach n $subMenuFilesetInfo($fset) {
  543.         cache::add filesetMenuCache "variable" subMenuInfo($n)
  544.     }
  545.     cache::add filesetMenuCache "variable" subMenuFilesetInfo($n)
  546.     }
  547.     if {[info exists fileSets($fset)]} {
  548.     cache::add filesetMenuCache "variable" fileSets($fset)
  549.     }
  550.     eval $m
  551.     callFilesetUpdateProcedures $fset
  552.     message "Done"
  553. }
  554.  
  555. proc callFilesetUpdateProcedures { {fset ""} } {
  556.     global filesetUpdateProcs gfileSetsType
  557.     if { $fset == "" } {
  558.     set types [array names filesetUpdateProcs]
  559.     } else {
  560.     set types $gfileSetsType($fset)
  561.     }
  562.     
  563.     foreach l $types {
  564.     if {[info exists filesetUpdateProcs($l)]} {
  565.         foreach proc $filesetUpdateProcs($l) {
  566.         uplevel \#0 $proc
  567.         }
  568.     }
  569.     }
  570.     
  571. }
  572.  
  573. # ◊◊◊◊ Creation of basic fileset types ◊◊◊◊ #
  574.  
  575. proc proceduralCreateFileset {} {
  576.     global gfileSets gfileSetsType filesetsNotInMenu modifiedArrayElements
  577.     set name [getline "Name for this fileset…"]
  578.     if {![string length $name]} return
  579.     set gfileSetsType($name) "procedural"
  580.     set p procFileset[join $name ""]
  581.     set gfileSets($name) $p
  582.     addUserLine "\# procedure to list files in fileset '$name' on the fly"
  583.     addUserLine "proc $p \{\} \{"
  584.     addUserLine "\t"
  585.     addUserLine "\}"
  586.     lappend modifiedArrayElements [list $name gfileSets]
  587.     lappend modifiedArrayElements [list $name gfileSetsType]
  588.     if {[dialog::yesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"]} {
  589.     global::editPrefsFile
  590.     goto [maxPos]
  591.     beep
  592.     message "Make sure you 'load' the new procedure."
  593.     }
  594.     lappend filesetsNotInMenu $name
  595.     return $name
  596. }
  597.  
  598. # under development
  599. proc fileset::createfromDirectory {x y} {
  600.     eval lappend dial \
  601.       [dialog::edit "New fileset name:" $x y 20] \
  602.       [dialog::edit "New fileset dir:" $x y 20] \
  603.       [dialog::edit "File pattern:" $x y 20]
  604. }
  605.  
  606. proc fromDirectoryCreateFileset {} {
  607.     global gfileSets gfileSetsType fileSetsExtra
  608.     
  609.     set name [getFilesetDirectoryAndPattern]
  610.     if {![string length $name]} return
  611.     set filePatIgnore [getline "List of file patterns to ignore:" ""]
  612.     if {$filePatIgnore != ""} {
  613.     set fileSetsExtra($name) $filePatIgnore
  614.     }
  615.     
  616.     set gfileSetsType($name) "fromDirectory"
  617.     
  618.     if {[dialog::yesno "Save new fileset?"]} {
  619.     global modifiedArrayElements
  620.     lappend modifiedArrayElements [list $name gfileSets]
  621.     lappend modifiedArrayElements [list $name gfileSetsType]
  622.     if {[info exists fileSetsExtra($name)]} {
  623.         lappend modifiedArrayElements [list $name fileSetsExtra]
  624.     }
  625.     }
  626.     return $name
  627. }
  628.  
  629. proc getFilesetDirectoryAndPattern {} {
  630.     global gfileSets fileSetsExtra
  631.     set name [getline "New fileset name:" ""]
  632.     if {![string length $name]} return
  633.     
  634.     set dir [get_directory -p "New fileset dir:"]
  635.     if {![string length $dir]} return
  636.     
  637.     set filePat [getline "File pattern:" "*"]
  638.     if {![string length $filePat]} return
  639.     
  640.     set gfileSets($name) [file join $dir $filePat]
  641.     return $name
  642. }
  643.  
  644. proc fromDirectoryFilesetUpdate {name} {
  645.     # done on the fly so no need to update
  646.     #global fileSets gfileSets
  647.     #set fileSets($name) [glob -t TEXT -nocomplain "$gfileSets($name)"]
  648. }
  649.  
  650. proc fromHierarchyCreateFileset {} {
  651.     global gfileSets gfileSetsType    
  652.     
  653.     set name [getFilesetDirectoryAndPattern]
  654.     if {![string length $name]} return
  655.     
  656.     set gfileSetsType($name) "fromHierarchy"
  657.     set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
  658.     if { $depth == "" } {set depth 3}
  659.     
  660.     set gfileSets($name) [list $gfileSets($name) $depth]
  661.     
  662.     if {[dialog::yesno "Save new fileset?"]} {
  663.     global modifiedArrayElements
  664.     lappend modifiedArrayElements [list $name gfileSets] \
  665.       [list $name gfileSetsType]
  666.     }
  667.     return $name
  668. }
  669.  
  670. proc fromHierarchyFilesetUpdate {name} {
  671.     fromHierarchyMakeFileSet $name 0
  672. }
  673.  
  674. proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
  675.     global filesetTemp fileSets gfileSets
  676.     set dir [file dirname [lindex $gfileSets($name) 0]]
  677.     set patt [file tail [lindex $gfileSets($name) 0]]
  678.     set depth [lindex $gfileSets($name) 1]
  679.     # we make the menu as a string, but can bin it if we like
  680.     set menu [menu::buildHierarchy [list $dir] $name filesetProc filesetTemp $patt $depth $name]
  681.     
  682.     # we need to construct the list of items
  683.     set fileSets($name) {}
  684.     if {[info exists filesetTemp]} {
  685.     foreach n [array names filesetTemp] {
  686.         lappend fileSets($name) $filesetTemp($n)
  687.     }
  688.     unset filesetTemp
  689.     }
  690.     return $menu
  691. }
  692.  
  693. proc fromHierarchyFilesetSelected {fset menu item} {
  694.     global gfileSets
  695.     set dir [file dirname [lindex $gfileSets($fset) 0]]
  696.     set ff [getFilesInSet $fset]
  697.     if { $fset == $menu } {
  698.     # it's top level
  699.     if {[set match [lsearch $ff [file join ${dir} $item]]] >= 0} {
  700.         autoUpdateFileset $fset
  701.         generalOpenFileitem [lindex $ff $match]
  702.         return
  703.     }
  704.     }
  705.     # the following two are slightly cumbersome, but give us the best
  706.     # chance of finding the correct file given any ambiguity (which can
  707.     # certainly arise if file and directory names clash excessively).
  708.     if {[set match [lsearch $ff [file join ${dir} ${menu} $item]]] >= 0} {
  709.     autoUpdateFileset $fset
  710.     generalOpenFileitem [lindex $ff $match]
  711.     return
  712.     }
  713.     if {[set match [lsearch $ff [file join ${dir} * ${menu} $item]]] >= 0} {
  714.     autoUpdateFileset $fset
  715.     generalOpenFileitem [lindex $ff $match]
  716.     return
  717.     }
  718.     error "Weird! Couldn't find it."
  719. }
  720.  
  721.  
  722. proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
  723. proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
  724.  
  725. proc fromOpenWindowsCreateFileset {} {
  726.     global gfileSets modifiedArrayElements
  727.     
  728.     set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]
  729.     
  730.     set gfileSets($name) [winNames -f]
  731.     lappend modifiedArrayElements [list $name gfileSets]
  732.     
  733.     return $name
  734. }
  735.  
  736.  
  737. # ◊◊◊◊ Menu procedures ◊◊◊◊ #
  738.  
  739. ## 
  740.  # Global procedures to    deal with the fact that    Alpha can only have    one
  741.  # menu    with each given    name.  This    is only    a problem in dealing with
  742.  # user-defined    menus such as fileset menus, tex-package menus,    ...
  743.  ##
  744.  
  745. ## 
  746.  # -------------------------------------------------------------------------
  747.  #     
  748.  #    "makeFilesetSubMenu" --
  749.  #    
  750.  # If desired this is the only procedure you need use --- it returns a menu
  751.  # creation string, taking account of the unique name requirement and will
  752.  # make sure your procedure 'proc' is called with the real menu name! 
  753.  # -------------------------------------------------------------------------
  754.  ##
  755. proc makeFilesetSubMenu {fset name proc args} {
  756.     if { [string length $proc] > 1 } {
  757.     return [concat {Menu -m -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
  758.     } else {
  759.     return [concat {Menu -m -n} [list [registerFilesetMenuName $fset $name]] $args]
  760.     }
  761. }
  762.  
  763. ## 
  764.  # -------------------------------------------------------------------------
  765.  #     
  766.  #    "registerFilesetMenuName" --
  767.  #    
  768.  # Call to ensure unique fileset submenu names.  We just add spaces as
  769.  # appropriate and keep track of everything for you!  Filesets which have
  770.  # multiple menus _must_ register the main menu first. 
  771.  # -------------------------------------------------------------------------
  772.  ##
  773. proc registerFilesetMenuName {fset name {proc ""}} {
  774.     global subMenuInfo subMenuFilesetInfo
  775.     if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
  776.     # if the fileset already has a base menu, use that:
  777.     foreach n $subMenuFilesetInfo($fset) {
  778.         if { [string trimright $n] == $fset } {
  779.         set base $n
  780.         } 
  781.         unset subMenuInfo($n)
  782.     }
  783.     unset subMenuFilesetInfo($fset)
  784.     }
  785.     set original $name                    
  786.     if {[info exists base]} {
  787.     set name $base
  788.     } else {
  789.     # I add at least one space to _all_ hierarchical submenus now.
  790.     # This is so I won't clash with any current or future modes
  791.     # which should never normally add spaces themselves.
  792.     append name " "
  793.     while { [info exists subMenuInfo($name)] } {
  794.         append name " "
  795.     }        
  796.     }
  797.     
  798.     set subMenuInfo($name) [list "$fset" "$original" "$proc"]
  799.     # build list of a fileset's menus
  800.     lappend subMenuFilesetInfo($fset) "$name"
  801.     
  802.     return $name
  803. }
  804.  
  805.  
  806. proc realMenuName {name} {
  807.     global subMenuInfo
  808.     return [lindex $subMenuInfo($name) 1]
  809. }
  810.  
  811. ## 
  812.  # -------------------------------------------------------------------------
  813.  #     
  814.  #    "subMenuProc" --
  815.  #    
  816.  # This procedure is implicitly used to deal with ensuring unique sub-menu
  817.  # names.  It calls the procedure you asked for, with the name of the menu
  818.  # you think you're using. 
  819.  # -------------------------------------------------------------------------
  820.  ##
  821. proc subMenuProc {menu item} {
  822.     global subMenuInfo
  823.     set l $subMenuInfo($menu)
  824.     set realProc [lindex $l 2]
  825.     if {[info commands $realProc] == ""} {catch "$realProc"}
  826.     # try to call the proc with three arguments (fileset is 1st)
  827.     if {[llength [info args $realProc]] == 2} {
  828.     $realProc [lindex $l 1] "$item"
  829.     } else {
  830.     $realProc [lindex $l 0] [lindex $l 1] "$item"
  831.     }
  832. }
  833.  
  834.  
  835. proc filesetMenuProc {menu item} {
  836.     switch $item {
  837.     "Edit File" {
  838.         editFile
  839.         return
  840.     } 
  841.     "Help" {
  842.         global HOME
  843.         editMark [file join $HOME Help "Alpha Manual"] "File Sets" -r
  844.         return
  845.     }
  846.     }
  847. }
  848.  
  849. ## 
  850.  # -------------------------------------------------------------------------
  851.  #     
  852.  #    "filesetProc" --
  853.  #    
  854.  # Must be called by 'subMenuProc'
  855.  # -------------------------------------------------------------------------
  856.  ##
  857. proc filesetProc {fset menu item} {
  858.     global gfileSetsType 
  859.     if {$fset != ""} {set m $fset} else { set m $menu}
  860.     switch -- $gfileSetsType($m) {
  861.     "fromDirectory" -
  862.     "think" -
  863.     "codewarrior" -
  864.     "fromOpenWindows" {
  865.         if {[catch {filesetBasicOpen $m $item}]} {
  866.         if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  867.             updateAFileset $fset
  868.         }
  869.         }
  870.     }
  871.     "ftp" { ftpFilesetOpen $m $item }
  872.     "default" {
  873.         # try a type-specific method first
  874.         set proc $gfileSetsType($m)FilesetSelected
  875.         if {[info commands $proc] == "" && (![auto_load $proc])} {
  876.         # if that failed then just hope it's an ordinary list
  877.         if {![catch {filesetBasicOpen $m $item}]} {return}
  878.         } else {
  879.         if {[llength [info args $proc]] == 2} {
  880.             if {![catch {eval [list $proc $menu $item]}]} {return}
  881.         } else {
  882.             if {![catch {eval [list $proc $fset $menu $item]}]} {return}
  883.         }
  884.         }
  885.         
  886.         if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  887.         updateAFileset $fset
  888.         }
  889.     }
  890.     }
  891. }
  892.  
  893. proc filesetBasicOpen { menu item } {
  894.     global file::separator
  895.     if {[set match [lsearch [getFilesInSet $menu] *${file::separator}$item]] >= 0} {
  896.     autoUpdateFileset $menu
  897.     generalOpenFileitem [lindex [getFilesInSet $menu] $match]
  898.     return
  899.     }
  900.     error "file not found"
  901. }
  902.  
  903. ## 
  904.  # -------------------------------------------------------------------------
  905.  # 
  906.  # "generalOpenFileitem" --
  907.  # 
  908.  #  Works around an alpha bug with aliases.
  909.  # -------------------------------------------------------------------------
  910.  ##
  911. proc generalOpenFileitem {file} {
  912.     if {[file isfile $file]} {
  913.     file::openAny $file
  914.     } else {
  915.     # is it an alias?
  916.     if {[file type $file] == "unknown"} {
  917.         getFileInfo $file a
  918.         # is it a folder?
  919.         if {$a(type) != "fdrp"} {
  920.         file::openAny $file
  921.         return
  922.         }
  923.     }
  924.     global file::separator
  925.     findFile "${file}${file::separator}"
  926.     }
  927. }
  928.  
  929. proc registerUpdateProcedure { type proc } {
  930.     global filesetUpdateProcs
  931.     lappend filesetUpdateProcs($type) $proc
  932. }
  933.  
  934. proc filesetUtilsProc { menu item } {
  935.     global filesetUtils gfileSetsType currFileSet
  936.     if {[info exists filesetUtils($item)]} {
  937.     # it's a utility
  938.     set utilDesc $filesetUtils($item)
  939.     set allowedTypes [lindex $utilDesc 0]
  940.     if {[string match $allowedTypes $gfileSetsType($currFileSet)]} {
  941.         return [eval [lindex $utilDesc 1]]
  942.     } else {
  943.         beep
  944.         message "That utility can't be applied to the current file-set."
  945.         return
  946.     }
  947.     } else {
  948.     $item
  949.     }
  950. }
  951. proc getFilesInSet {fset} {
  952.     global gfileSets fileSetsTypesThing gfileSetsType
  953.     switch -- $fileSetsTypesThing($gfileSetsType($fset)) {
  954.     "list" {
  955.         return $gfileSets($fset)
  956.     }
  957.     "glob" {
  958.         global filesetmodeVars fileSetsExtra
  959.         if {$filesetmodeVars(includeNonTextFiles)} {
  960.         set l [glob -nocomplain "$gfileSets($fset)"]
  961.         if {[info exists fileSetsExtra($fset)]} {
  962.             foreach pat $fileSetsExtra($fset) {
  963.             foreach f [glob -nocomplain [file join [file dirname "$gfileSets($fset)"] $pat]] {
  964.                 set i [lsearch $l $f]
  965.                 set l [lreplace $l $i $i]
  966.             }
  967.             }
  968.         }
  969.         return $l
  970.         } else {
  971.         set l [glob -t TEXT -nocomplain "$gfileSets($fset)"]
  972.         if {[info exists fileSetsExtra($fset)]} {
  973.             foreach pat $fileSetsExtra($fset) {
  974.             foreach f [glob -t TEXT -nocomplain [file join [file dirname "$gfileSets($fset)"] $pat]] {
  975.                 set i [lsearch $l $f]
  976.                 set l [lreplace $l $i $i]
  977.             }
  978.             }
  979.         }
  980.         return $l
  981.         }
  982.     }
  983.     "procedural" {
  984.         return [$gfileSets($fset)]
  985.     }        
  986.     "default" {
  987.         global fileSets
  988.         if {![info exists fileSets($fset)]} {
  989.         # This means the menu was cached, but this info wasn't.
  990.         # We calculate the set, and menu, and cache them
  991.         # (since they're at the end of the file, they over-ride
  992.         # what's there.
  993.         
  994.         # we rebuild the menu too
  995.         eval [makeFileSetAndMenu $fset 1]
  996.         cache::add filesetMenuCache "variable" fileSets($fset)
  997.         }
  998.         return $fileSets($fset)
  999.     }
  1000.     }
  1001. }
  1002.  
  1003. proc makeFileSetAndMenu {name andMenu {use_cache 0}} {
  1004.     if {$use_cache} {
  1005.     set m [cache::snippetRead $name]
  1006.     if {$m != ""} {return $m}
  1007.     }
  1008.     global gfileSetsType fileSetsTypesThing
  1009.     message "Building ${name}..."
  1010.     set type $gfileSetsType($name)
  1011.     switch -- $fileSetsTypesThing($type) {
  1012.     "list" -
  1013.     "glob" {
  1014.         if {$andMenu} {
  1015.         set menu {}
  1016.         foreach m [getFilesInSet $name] {
  1017.             lappend menu "[file tail $m]&"
  1018.         }
  1019.         set m [makeFilesetSubMenu $name $name filesetProc [lsort -increasing $menu]]
  1020.         } else {
  1021.         return
  1022.         }
  1023.     }
  1024.     "procedural" {
  1025.         return
  1026.     }
  1027.     "default" {
  1028.         set m [${type}MakeFileSetAndMenu $name $andMenu]
  1029.         
  1030.     }
  1031.     }     
  1032.     cache::snippetWrite $name $m
  1033.     return $m
  1034. }
  1035.  
  1036. proc filesetsSorted { order usedvar {use_cache 0}} {
  1037.     upvar $usedvar used
  1038.     global filesetmodeVars gfileSets gfileSetsType
  1039.     set sets {}
  1040.     foreach item $order {
  1041.     switch -- [lindex $item 0] {
  1042.         "-" { 
  1043.         # add divider
  1044.         lappend sets "(-" 
  1045.         continue
  1046.         } 
  1047.         "*" {
  1048.         # add all the rest
  1049.         set subset {}
  1050.         foreach s [array names gfileSets] {
  1051.             if {![lcontains used $s]}  {
  1052.             lappend subset $s
  1053.             lappend used $s
  1054.             }
  1055.         }
  1056.         foreach f [lsort $subset] {
  1057.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1058.         }
  1059.         } 
  1060.         "pattern" {
  1061.         # find all which match a given pattern
  1062.         set patt [lindex $item 1]
  1063.         set subset {}
  1064.         foreach s [array names gfileSets] {
  1065.             if {![lcontains used $s]}  {
  1066.             if {[string match $patt $s]} {
  1067.                 lappend subset $s
  1068.                 lappend used $s
  1069.             }
  1070.             }
  1071.         }
  1072.         foreach f [lsort $subset] {
  1073.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1074.         }
  1075.         
  1076.         }
  1077.         "submenu" {
  1078.         # add a submenu with name following and sub-order
  1079.         set name [lindex $item 1]
  1080.         set suborder [lrange $item 2 end]              
  1081.         # we make kind of a pretend fileset here.
  1082.         set subsets [filesetsSorted $suborder used]
  1083.         if { $subsets != "" } {
  1084.             lappend sets [makeFilesetSubMenu $name $name filesetProc $subsets]
  1085.         }
  1086.         }
  1087.         "default" {        
  1088.         set subset {} 
  1089.         foreach s [array names gfileSets] {
  1090.             if {[lcontains item $gfileSetsType($s)] && ![lcontains used $s]}  {
  1091.             lappend subset $s
  1092.             lappend used $s
  1093.             }
  1094.         }
  1095.         foreach f [lsort $subset] {
  1096.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1097.         }
  1098.         }
  1099.     }
  1100.     
  1101.     }
  1102.     # remove multiple and leading, trailing '-' in case there were gaps
  1103.     regsub -all {\(-( \(-)+} $sets {(-} sets
  1104.     while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
  1105.     set l [expr {[llength $sets] -1}]
  1106.     if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }
  1107.     
  1108.     return $sets
  1109. }
  1110.  
  1111. ## 
  1112.  # -------------------------------------------------------------------------
  1113.  # 
  1114.  # "rebuildFilesetMenu" --
  1115.  # 
  1116.  #  Reads the fileset menu from the cache if it exists.  This speeds up
  1117.  #  start-up by quite a bit.
  1118.  # -------------------------------------------------------------------------
  1119.  ##
  1120. proc rebuildFilesetMenu {} { 
  1121.     message "Building filesets..."
  1122.     if {[cache::exists filesetMenuCache]} {
  1123.     global subMenuFilesetInfo subMenuInfo fileSets
  1124.     cache::read filesetMenuCache 
  1125.     rebuildFilesetUtilsMenu
  1126.     callFilesetUpdateProcedures
  1127.     } else {
  1128.     rebuildAllFilesets 1
  1129.     }
  1130.     
  1131. }
  1132.     
  1133. ## 
  1134.  # -------------------------------------------------------------------------
  1135.  #     
  1136.  #    "zapAndBuildFilesets" --
  1137.  #    
  1138.  # This does a complete rebuild of all information.  The problem is that
  1139.  # the names of menus may actually change (spaces added/deleted).  This is
  1140.  # not a problem for the fileset menu, but is a problem for any filesets
  1141.  # which have been added to other menus, since they won't know that they
  1142.  # need to be rebuilt. 
  1143.  # -------------------------------------------------------------------------
  1144.  ##
  1145. proc zapAndBuildFilesets {} {
  1146.     global subMenuInfo subMenuFilesetInfo
  1147.     unset subMenuInfo
  1148.     unset subMenuFilesetInfo
  1149.     rebuildAllFilesets
  1150. }
  1151.  
  1152. proc rebuildAllFilesets { {use_cache 0} } {
  1153.     global gfileSets filesetMenu  filesetSortOrder 
  1154.     global filesetmodeVars filesetsNotInMenu fileSets
  1155.     message "Rebuilding filesets menu…"
  1156.     
  1157.     if {$filesetmodeVars(sortFilesetsByType)} {
  1158.     # just make file-sets for those we don't want in the menu
  1159.     if {!$use_cache} {
  1160.         foreach f $filesetsNotInMenu {
  1161.         makeFileSetAndMenu $f 0 
  1162.         }
  1163.     }
  1164.     set used $filesetsNotInMenu
  1165.     set sets [filesetsSorted $filesetSortOrder used $use_cache]
  1166.     } else {
  1167.     foreach f [lsort [array names gfileSets]] {
  1168.         set doMenu [expr {![lcontains filesetsNotInMenu $f]}]
  1169.         set menu [makeFileSetAndMenu $f $doMenu $use_cache]
  1170.         if {$doMenu && [llength $menu]} {
  1171.         lappend sets $menu
  1172.         }        
  1173.     }            
  1174.     }
  1175.     
  1176.     regsub -all {[-][nm]} $sets "" names
  1177.     foreach nn $names {
  1178.     lappend names_ [string trimright [lindex $names 1]]
  1179.     }
  1180.     set names $names_
  1181.     
  1182.     # cache the fileset menu
  1183.     set m [list Menu -m -n $filesetMenu -p filesetMenuProc \
  1184.       [concat {{/'Edit File…} {Menu -n Utilities {}}} "Help" \
  1185.       "(-" $sets]]
  1186.     cache::create filesetMenuCache 
  1187.     cache::add filesetMenuCache "eval" $m [list insertMenu $filesetMenu]
  1188.     global subMenuFilesetInfo subMenuInfo
  1189.     cache::add filesetMenuCache "variable" subMenuFilesetInfo subMenuInfo fileSets
  1190.     eval $m
  1191.     
  1192.     rebuildFilesetUtilsMenu
  1193.     callFilesetUpdateProcedures
  1194.     
  1195.     message ""
  1196. }
  1197.  
  1198. ## 
  1199.  # -------------------------------------------------------------------------
  1200.  #     
  1201.  #    "rebuildSomeFilesetMenu" --
  1202.  #    
  1203.  # If given '*' rebuild the entire menu, else rebuild only those types
  1204.  # given.  This is generally useful to avoid excessive rebuilding when
  1205.  # flags are adjusted
  1206.  # -------------------------------------------------------------------------
  1207.  ##
  1208. proc rebuildSomeFilesetMenu {args} {
  1209.     rebuildAllFilesets        
  1210. }
  1211.  
  1212. proc rebuildFilesetUtilsMenu {} {
  1213.     global gfileSets filesetUtils 
  1214.     
  1215.     Menu -n "Utilities" -p filesetUtilsProc [concat \
  1216.       "newFileset…" \
  1217.       "deleteFileset…" \
  1218.       "printFileset…" \
  1219.       "<S<EupdateAFileset…" \
  1220.       "<SupdateCurrentFileset" \
  1221.       "<S<EzapAndBuildFilesets" \
  1222.       "<SrebuildAllFilesets" \
  1223.       [list [menu::makeFlagMenu choose list currFileSet]] \
  1224.       [list [list Menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]] \
  1225.       [list [menu::makeFlagMenu filesetFlags array filesetmodeVars]] \
  1226.       "(-" \
  1227.       "/T<I<OfindTag" \
  1228.       "createTagFile" \
  1229.       "(-" \
  1230.       [lsort [array names filesetUtils]] \
  1231.       ]
  1232.     
  1233.     filesetUtilsMarksTicks
  1234. }
  1235.  
  1236. proc rebuildSimpleFilesetMenus {} {
  1237.     global gfileSets fileSetsTypesThing
  1238.     eval [menu::makeFlagMenu choose list currFileSet]
  1239.     Menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
  1240.     filesetUtilsMarksTicks
  1241. }
  1242.  
  1243. proc hideShowFileset {menu item} {
  1244.     global filesetsNotInMenu filesetMenu
  1245.     if {[lcontains filesetsNotInMenu $item]} {
  1246.     global gfileSetsType
  1247.     if {$gfileSetsType($item) == "procedural"} {
  1248.         alertnote "Sorry, procedural filesets are completely dynamic and cannot appear in menus."
  1249.         return
  1250.     }
  1251.     set idx [lsearch $filesetsNotInMenu $item]
  1252.     set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]        
  1253.     markMenuItem -m hideFileset $item off
  1254.     # would be better if we could just insert it
  1255.     rebuildAllFilesets 1
  1256.     } else {
  1257.     lappend filesetsNotInMenu $item
  1258.     markMenuItem -m hideFileset $item on
  1259.     if {[catch {removeFilesetFromMenu $item}]} {
  1260.         rebuildAllFilesets 1
  1261.     }
  1262.     }
  1263.     global modifiedVars
  1264.     lappend modifiedVars filesetsNotInMenu
  1265. }
  1266.  
  1267. proc filesetUtilsMarksTicks {} {
  1268.     global filesetsNotInMenu
  1269.     
  1270.     foreach name $filesetsNotInMenu {
  1271.     markMenuItem -m hideFileset $name on
  1272.     }
  1273.     
  1274. }
  1275.  
  1276.  
  1277. # Called in response to user changing filesets from the fileset menu.
  1278. proc changeFileSet {item} {
  1279.     global currFileSet tagFile
  1280.     # Bring in the tags file for this fileset
  1281.     set fname [tagFileName]
  1282.     if {[file exists $fname]} {
  1283.     if {[dialog::yesno "Use tag file from folder \"$dir\" ?"]} {
  1284.         set tagFile $fname
  1285.     }
  1286.     }
  1287. }
  1288.  
  1289. proc autoUpdateFileset { name } {
  1290.     global currFileSet filesetmodeVars modifiedVars
  1291.     if {$filesetmodeVars(autoAdjustFileset)} {
  1292.     set currFileSet $name
  1293.     lunion modifiedVars currFileSet
  1294.     }
  1295. }
  1296.  
  1297.  
  1298. # ◊◊◊◊ Utility procs ◊◊◊◊ #
  1299.  
  1300. proc isWindowInFileset { {win "" } {type ""} } {
  1301.     if {$win == ""} { set win [win::Current] }
  1302.     global currFileSet gfileSets gfileSetsType
  1303.     
  1304.     if { $type == "" } {
  1305.     set okSets [array names gfileSets]
  1306.     } else {
  1307.     set okSets {}
  1308.     foreach s [array names gfileSets] {
  1309.         if { $gfileSetsType($s) == $type } {
  1310.         lappend okSets $s
  1311.         }
  1312.     }
  1313.     }
  1314.     
  1315.     if {[array exists gfileSets]} {
  1316.     if {[lsearch -exact $okSets $currFileSet] != -1 } {
  1317.         # check current fileset
  1318.         if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
  1319.         # we're set, it's in this fileset
  1320.         return  $currFileSet
  1321.         }
  1322.     }
  1323.     
  1324.     # check other fileset
  1325.     foreach fset $okSets {
  1326.         if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
  1327.         # we're set, it's in this project
  1328.         return  $fset
  1329.         }
  1330.     }   
  1331.     }
  1332.     return ""
  1333.     
  1334. }
  1335.  
  1336.  
  1337.  
  1338. ## 
  1339.  # -------------------------------------------------------------------------
  1340.  #     
  1341.  #    "iterateFileset" --
  1342.  # 
  1343.  #  Utility procedure to iterate over all files in a project, calling some
  1344.  #  predefined function '$fn' for each member of project '$proj'.  The
  1345.  #  results of such a call are passed to '$resfn' if given.  Finally "done"
  1346.  #  is passed to 'resfn'.
  1347.  #     
  1348.  # -------------------------------------------------------------------------
  1349.  ##
  1350. proc iterateFileset { proj fn { resfn \# } } {
  1351.     global gfileSets gfileSetsType
  1352.     eval $resfn "first"
  1353.     
  1354.     set check [expr {![catch {$gfileSetsType($proj)IterateCheck check}]}]
  1355.     
  1356.     foreach ff [getFileSet $proj] {
  1357.     if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  1358.         continue
  1359.     }
  1360.     set res [eval $fn [list $ff]]
  1361.     eval $resfn [list $res]
  1362.     }
  1363.     
  1364.     if {$check} {
  1365.     catch {$gfileSetsType($proj)IterateCheck done}
  1366.     }
  1367.     
  1368.     eval $resfn "done"
  1369.     
  1370. }
  1371.  
  1372. # ◊◊◊◊ Tags ◊◊◊◊ #
  1373.  
  1374. if {![string length [info commands alphaFindTag]]} {
  1375.     rename findTag alphaFindTag
  1376.     rename createTagFile alphaCreateTagFile
  1377. }
  1378.  
  1379. proc tagFileName {} {
  1380.     global gfileSets currFileSet 
  1381.     return [file join [file dirname [car $gfileSets($currFileSet)]] "[join ${currFileSet}]TAGS"]
  1382. }
  1383.  
  1384. proc findTag {} {
  1385.     global gfileSetsType currFileSet
  1386.     # try a type-specific method first
  1387.     if {[catch {$gfileSetsType($currFileSet)FindTag}]} {
  1388.     alphaFindTag
  1389.     }
  1390. }
  1391.  
  1392. proc createTagFile {} {
  1393.     global gfileSetsType currFileSet tagFile modifiedVars
  1394.     set tagFile [tagFileName]
  1395.     lappend modifiedVars tagFile
  1396.     
  1397.     # try a type-specific method first
  1398.     if {[catch {$gfileSetsType($currFileSet)CreateTagFile}]} {
  1399.     alphaCreateTagFile
  1400.     }
  1401. }
  1402.  
  1403. # ◊◊◊◊ Utils ◊◊◊◊ #
  1404.  
  1405.     
  1406. proc dirtyFileset { fset } {
  1407.     foreach f [getFilesInSet $fset] {
  1408.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  1409.     }
  1410.     return 0
  1411. }
  1412.  
  1413. proc saveEntireFileset { fset } {
  1414.     foreach f [getFilesInSet $fset] {
  1415.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  1416.         bringToFront $f
  1417.         save 
  1418.     }
  1419.     }
  1420. }
  1421.  
  1422. proc closeEntireFileset { {fset ""} } {
  1423.     if {[catch {pickFileset $fset "Close which fileset?" "popup"} fset]} {return}
  1424.     
  1425.     foreach f [getFilesInSet $fset] {
  1426.     if {![catch {getWinInfo -w $f arr}]} {
  1427.         bringToFront $f
  1428.         killWindow
  1429.     }
  1430.     }
  1431. }
  1432.  
  1433. proc fileToAlpha {f} {
  1434.     if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  1435.     message "Converting $f"
  1436.     setFileInfo $f creator ALFA
  1437.     }    
  1438. }
  1439.  
  1440. proc filesetToAlpha {} {
  1441.     if {[catch {pickFileset "" {Convert all files from which fileset?} "popup"} fset]} {return}
  1442.     iterateFileset $fset fileToAlpha
  1443. }
  1444.  
  1445. ## 
  1446.  # -------------------------------------------------------------------------
  1447.  # 
  1448.  # "replaceInFileset" --
  1449.  # 
  1450.  #  Quotes things correctly so searches work, and adds a check on
  1451.  #  whether there are any windows.
  1452.  # -------------------------------------------------------------------------
  1453.  ##
  1454. proc replaceInFileset {} {
  1455.     global gfileSets win::NumDirty
  1456.     set how [dialog::optionMenu "Search type:" \
  1457.       [list "Textual replace" "Case-independent textual replace" \
  1458.       "Regexp replace" "Case-independent regexp replace"] "" 1]
  1459.     set from [prompt "Search string:" [searchString]]
  1460.     searchString $from
  1461.     if {$how < 2} {set from [quote::Regfind $from]}
  1462.     
  1463.     set to [prompt "Replace string:" [replaceString]]
  1464.     replaceString $to
  1465.     if {$how < 2} {set to [quote::Regsub $to]}
  1466.     if {[catch {regsub -- $from "$from" $to dummy} err]} {
  1467.     alertnote "Regexp compilation problems: $err"
  1468.     return
  1469.     }
  1470.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  1471.     
  1472.     if {${win::NumDirty}} {
  1473.     if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  1474.     saveAll
  1475.     }
  1476.     
  1477.     set cid [scancontext create]
  1478.     set changes 0
  1479.     if {$how & 1} {
  1480.     set case "-nocase"
  1481.     } else {
  1482.     set case "--"
  1483.     }
  1484.     
  1485.     scanmatch $case $cid $from {set matches($f) 1 ;incr changes}
  1486.     foreach fset $fsets {
  1487.     foreach f [getFileSet $fset] {
  1488.         if {![catch {set fid [open $f]}]} {
  1489.         message "Looking at '[file tail $f]'"
  1490.         scanfile $cid $fid
  1491.         close $fid
  1492.         }
  1493.     }
  1494.     }
  1495.     
  1496.     scancontext delete $cid
  1497.     
  1498.     foreach f [array names matches] {
  1499.     message "Modifying ${f}…"
  1500.     set cid [open $f "r"]
  1501.     if {[regsub -all $case $from [read $cid] $to out]} {
  1502.         set ocid [open $f "w+"]
  1503.         puts -nonewline $ocid $out
  1504.         close $ocid
  1505.     }
  1506.     close $cid
  1507.     }
  1508.     
  1509.     eval file::revertThese [array names matches]
  1510.     message "Replaced $changes instances"
  1511. }
  1512.  
  1513. proc openEntireFileset {} {
  1514.     set fset [pickFileset "" "Open which fileset?" "popup"]
  1515.     
  1516.     # we use our iterator in case there's something special to do
  1517.     iterateFileset $fset "edit -c -w"
  1518. }
  1519.  
  1520. proc openFilesetFolder {} {
  1521.     global gfileSets
  1522.     set fset [pickFileset "" "Open which fileset's folder?" "popup"]
  1523.     if {[llength [list $gfileSets($fset)]] == 1 && [file isdirectory [set dir [file dirname $gfileSets($fset)]]]} {
  1524.     openFolder $dir
  1525.     } else {
  1526.     alertnote "Fileset not connected to a folder."
  1527.     }
  1528. }
  1529.  
  1530. proc stuffFileset {} {
  1531.     global gfileSetsType gfileSets
  1532.     set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
  1533.     if {[string length $fset]} {
  1534.     if { $gfileSetsType($fset) == "fromDirectory" && \
  1535.       [dialog::yesno "Stuff entire directory?"]} {
  1536.         app::launchFore DStf
  1537.         regexp {ZZ(.)ZZ} [file join ZZ ZZ] "" separator
  1538.         sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]${separator}"
  1539.     } else {            
  1540.         app::launchFore DStf
  1541.         eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  1542.     }        
  1543.     sendQuitEvent 'DStf'
  1544.     }
  1545. }
  1546.  
  1547. proc filesetRememberOpenClose { file } {
  1548.     global fileset_openorclosed
  1549.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  1550. }
  1551.  
  1552. proc filesetRevertOpenClose { file } {
  1553.     global fileset_openorclosed
  1554.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  1555.     if { [lindex $fileset_openorclosed 1] < 0 } {
  1556.         killWindow
  1557.     }
  1558.     }    
  1559.     catch {unset fileset_openorclosed}
  1560. }
  1561.  
  1562. proc wordCountFileset {} {
  1563.     global currFileSet
  1564.     iterateFileset $currFileSet wordCountProc filesetUtilWordCount
  1565. }
  1566.  
  1567. proc filesetUtilWordCount {count} {
  1568.     global fs_ccount fs_wcount fs_lcount
  1569.     switch $count {
  1570.     "first" {
  1571.         set fs_ccount 0
  1572.         set fs_wcount 0
  1573.         set fs_lcount 0
  1574.     }       
  1575.     "done" {
  1576.         alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_lcount chars"
  1577.         unset fs_ccount fs_wcount fs_lcount
  1578.     }
  1579.     default {
  1580.         incr fs_ccount [lindex $count 2]
  1581.         incr fs_wcount [lindex $count 1]
  1582.         incr fs_lcount [lindex $count 0]
  1583.     }
  1584.     }
  1585. }
  1586.  
  1587.  
  1588. ## 
  1589.  # -------------------------------------------------------------------------
  1590.  # 
  1591.  # "wordCountProc" --
  1592.  # 
  1593.  #  Completely new proc which does the same as the old one
  1594.  #  without opening lots of windows.
  1595.  #  *Very* memory comsuming for large files, though.
  1596.  #  But I think the old one was equally memeory consuming.
  1597.  #  
  1598.  #  Ok, this is not exactly a bug fix. It's a IMHO better option.
  1599.  #  
  1600.  # -------------------------------------------------------------------------
  1601.  ##
  1602.  
  1603. proc wordCountProc {file} {
  1604.     message "Counting [file tail $file]…"
  1605.     set fid [open $file r]
  1606.     set filecont [read $fid]
  1607.     close $fid
  1608.     if {[regexp {\n\r} $filecont]} {
  1609.     set newln "\n\r"
  1610.     } elseif {[regexp {\n} $filecont]} {
  1611.     set newln "\n"
  1612.     } else {
  1613.     set newln "\r"
  1614.     }
  1615.     set lines [expr {[regsub -all -- $newln $filecont " " filecont] + 1}]
  1616.     set chars [string length $filecont]
  1617.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $filecont " " filecont
  1618.     set words [llength $filecont]
  1619.     return "$chars $words $lines"
  1620. }
  1621.  
  1622.  
  1623. # ◊◊◊◊ From search dialog ◊◊◊◊ #
  1624.  
  1625. proc findNewFileset {} {
  1626.     return [newFileset]
  1627. }
  1628.  
  1629.  
  1630. proc findNewDirectory {} {
  1631.     global gfileSets currFileSet gfileSetsType gDirScan
  1632.     
  1633.     set dir [get_directory -p "Scan which folder?"]
  1634.     if {![string length $dir]} return
  1635.     
  1636.     set filePat {*}
  1637.     set name [file tail $dir]
  1638.     
  1639.     set gfileSets($name) [file join $dir $filePat]
  1640.     set gDirScan($name) 1
  1641.     set gfileSetsType($name) "fromDirectory"
  1642.     set currFileSet $name
  1643.     updateCurrentFileset
  1644.     return $name
  1645. }
  1646.  
  1647. # Should be last so all filesets make it in.
  1648. rebuildFilesetMenu
  1649.  
  1650.  
  1651.  
  1652.  
  1653.  
  1654.  
  1655.  
  1656.  
  1657.